home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch8 / Bounce2.frm (.txt) < prev    next >
Visual Basic Form  |  1999-05-28  |  10KB  |  283 lines
  1. VERSION 5.00
  2. Begin VB.Form frmBounce2 
  3.    Caption         =   "Bounce2"
  4.    ClientHeight    =   5235
  5.    ClientLeft      =   1320
  6.    ClientTop       =   825
  7.    ClientWidth     =   6870
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   349
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   458
  13.    Begin VB.PictureBox picHidden 
  14.       Height          =   495
  15.       Index           =   0
  16.       Left            =   480
  17.       ScaleHeight     =   435
  18.       ScaleWidth      =   555
  19.       TabIndex        =   6
  20.       Top             =   240
  21.       Visible         =   0   'False
  22.       Width           =   615
  23.    End
  24.    Begin VB.TextBox txtFramesPerSecond 
  25.       Height          =   285
  26.       Left            =   1440
  27.       TabIndex        =   4
  28.       Text            =   "20"
  29.       Top             =   4920
  30.       Width           =   375
  31.    End
  32.    Begin VB.TextBox txtNumBalls 
  33.       Height          =   285
  34.       Left            =   1440
  35.       TabIndex        =   3
  36.       Text            =   "20"
  37.       Top             =   4560
  38.       Width           =   375
  39.    End
  40.    Begin VB.CommandButton cmdStart 
  41.       Caption         =   "Start"
  42.       Default         =   -1  'True
  43.       Height          =   495
  44.       Left            =   2160
  45.       TabIndex        =   1
  46.       Top             =   4620
  47.       Width           =   855
  48.    End
  49.    Begin VB.PictureBox picCourt 
  50.       AutoRedraw      =   -1  'True
  51.       Height          =   4455
  52.       Left            =   0
  53.       ScaleHeight     =   293
  54.       ScaleMode       =   3  'Pixel
  55.       ScaleWidth      =   453
  56.       TabIndex        =   0
  57.       Top             =   0
  58.       Width           =   6855
  59.    End
  60.    Begin VB.Label Label1 
  61.       Caption         =   "Frames per second:"
  62.       Height          =   255
  63.       Index           =   0
  64.       Left            =   0
  65.       TabIndex        =   5
  66.       Top             =   4920
  67.       Width           =   1455
  68.    End
  69.    Begin VB.Label Label1 
  70.       Caption         =   "Number of balls:"
  71.       Height          =   255
  72.       Index           =   1
  73.       Left            =   0
  74.       TabIndex        =   2
  75.       Top             =   4560
  76.       Width           =   1455
  77.    End
  78. Attribute VB_Name = "frmBounce2"
  79. Attribute VB_GlobalNameSpace = False
  80. Attribute VB_Creatable = False
  81. Attribute VB_PredeclaredId = True
  82. Attribute VB_Exposed = False
  83. Option Explicit
  84. Private xmax As Integer
  85. Private ymax As Integer
  86. Private NumBalls As Integer
  87. Private BallX() As Integer
  88. Private BallY() As Integer
  89. Private BallDx() As Integer
  90. Private BallDy() As Integer
  91. Private BallRadius() As Integer
  92. Private BallColor() As Long
  93. Private Playing As Boolean
  94. Private NumPlayed As Long
  95. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  96. ' Draw some random rectangles on the bacground.
  97. Private Sub DrawBackground()
  98. Dim i As Integer
  99. Dim wid As Single
  100. Dim hgt As Single
  101.     ' Start with a clean slate.
  102.     picCourt.Line (0, 0)-(picCourt.ScaleWidth, picCourt.ScaleHeight), picCourt.BackColor, BF
  103.     ' Draw some rectangles.
  104.     For i = 1 To 10
  105.         hgt = 10 + Rnd * xmax / 3
  106.         wid = 10 + Rnd * ymax / 3
  107.         picCourt.Line (Int(Rnd * xmax), Int(Rnd * ymax))-Step(hgt, wid), QBColor(Int(Rnd * 16)), BF
  108.     Next i
  109.     ' Make the rectangles part of the permanent background.
  110.     picCourt.Picture = picCourt.Image
  111. End Sub
  112. ' Generate some random data.
  113. Private Sub InitData()
  114. Dim ball As Integer
  115. Dim R As Integer
  116. Dim clr As Integer
  117.     ' See how many balls there should be.
  118.     If Not IsNumeric(txtNumBalls.Text) Then _
  119.         txtNumBalls.Text = "10"
  120.     NumBalls = CInt(txtNumBalls.Text)
  121.     ReDim BallRadius(1 To NumBalls)
  122.     ReDim BallX(1 To NumBalls)
  123.     ReDim BallY(1 To NumBalls)
  124.     ReDim BallDx(1 To NumBalls)
  125.     ReDim BallDy(1 To NumBalls)
  126.     ReDim BallColor(1 To NumBalls)
  127.     ' Set the initial ball data.
  128.     For ball = 1 To NumBalls
  129.         R = Int(10 * Rnd + 5)
  130.         BallRadius(ball) = R
  131.         BallX(ball) = Int((xmax - R + 1) * Rnd)
  132.         BallY(ball) = Int((ymax - R + 1) * Rnd)
  133.         BallDx(ball) = Int(21 * Rnd - 10)
  134.         BallDy(ball) = Int(21 * Rnd - 10)
  135.         clr = Int(15 * Rnd)
  136.         If clr >= 7 Then clr = clr + 1
  137.         BallColor(ball) = QBColor(clr)
  138.         ' Create a hidden PictureBox for this ball.
  139.         If ball > picHidden.UBound Then
  140.             Load picHidden(ball)
  141.         End If
  142.         ' Make the picture big enough.
  143.         picHidden(ball).Width = 2 * BallRadius(ball) + 4
  144.         picHidden(ball).Height = 2 * BallRadius(ball) + 4
  145.     Next ball
  146.     ' Unload any hidden PictureBoxes we no longer need.
  147.     For ball = NumBalls + 1 To picHidden.UBound
  148.         Unload picHidden(ball)
  149.     Next ball
  150. End Sub
  151. ' Start the animation.
  152. Private Sub cmdStart_Click()
  153.     If Playing Then
  154.         Playing = False
  155.         cmdStart.Caption = "Stopped"
  156.         cmdStart.Enabled = False
  157.     Else
  158.         cmdStart.Caption = "Stop"
  159.         Playing = True
  160.         InitData
  161.         PlayData
  162.         Playing = False
  163.         cmdStart.Caption = "Start"
  164.         cmdStart.Enabled = True
  165.     End If
  166. End Sub
  167. ' Play the animation.
  168. Private Sub PlayData()
  169. Dim ms_per_frame As Long
  170. Dim start_time As Single
  171. Dim stop_time As Single
  172.     ' Draw a random background.
  173.     DrawBackground
  174.     ' See how fast we should go.
  175.     If Not IsNumeric(txtFramesPerSecond.Text) Then _
  176.         txtFramesPerSecond.Text = "10"
  177.     ms_per_frame = 1000 \ CLng(txtFramesPerSecond.Text)
  178.     ' Start the animation.
  179.     NumPlayed = 0
  180.     start_time = Timer
  181.     PlayImages ms_per_frame
  182.     ' Display results.
  183.     stop_time = Timer
  184.     MsgBox "Displayed" & Str$(NumPlayed) & _
  185.         " frames in " & _
  186.         Format$(stop_time - start_time, "0.00") & _
  187.         " seconds (" & _
  188.         Format$(NumPlayed / (stop_time - start_time), "0.00") & _
  189.         " FPS)."
  190. End Sub
  191. ' Play the animation.
  192. Private Sub PlayImages(ByVal ms_per_frame As Long)
  193. Dim ball As Integer
  194. Dim next_time As Long
  195.     ' Get the current time.
  196.     next_time = GetTickCount()
  197.     ' Start the animation.
  198.     Do While Playing
  199.         NumPlayed = NumPlayed + 1
  200.         ' Save the background where the balls
  201.         ' will be placed.
  202.         For ball = 1 To NumBalls
  203.             picHidden(ball).PaintPicture _
  204.                 picCourt.Picture, _
  205.                 0, 0, _
  206.                 2 * BallRadius(ball) + 4, _
  207.                 2 * BallRadius(ball) + 4, _
  208.                 BallX(ball) - BallRadius(ball) - 2, _
  209.                 BallY(ball) - BallRadius(ball) - 2, _
  210.                 2 * BallRadius(ball) + 4, _
  211.                 2 * BallRadius(ball) + 4
  212.             picHidden(ball).Picture = picHidden(ball).Image
  213.         Next ball
  214.         ' Draw the balls.
  215.         For ball = 1 To NumBalls
  216.             picCourt.FillColor = BallColor(ball)
  217.             picCourt.Circle _
  218.                 (BallX(ball), BallY(ball)), _
  219.                 BallRadius(ball), BallColor(ball)
  220.         Next ball
  221.         ' Wait until it's time for the next frame.
  222.         next_time = next_time + ms_per_frame
  223.         WaitTill next_time
  224.         ' Restore the background information.
  225.         For ball = 1 To NumBalls
  226.             picCourt.PaintPicture _
  227.                 picHidden(ball).Picture, _
  228.                 BallX(ball) - BallRadius(ball) - 2, _
  229.                 BallY(ball) - BallRadius(ball) - 2, _
  230.                 2 * BallRadius(ball) + 4, _
  231.                 2 * BallRadius(ball) + 4, _
  232.                 0, 0, _
  233.                 2 * BallRadius(ball) + 4, _
  234.                 2 * BallRadius(ball) + 4
  235.         Next ball
  236.         ' Move the balls for the next frame,
  237.         ' keeping them within picCourt.
  238.         For ball = 1 To NumBalls
  239.             BallX(ball) = BallX(ball) + BallDx(ball)
  240.             If BallX(ball) < BallRadius(ball) Then
  241.                 BallX(ball) = 2 * BallRadius(ball) - BallX(ball)
  242.                 BallDx(ball) = -BallDx(ball)
  243.             ElseIf BallX(ball) > xmax - BallRadius(ball) Then
  244.                 BallX(ball) = 2 * (xmax - BallRadius(ball)) - BallX(ball)
  245.                 BallDx(ball) = -BallDx(ball)
  246.             End If
  247.             BallY(ball) = BallY(ball) + BallDy(ball)
  248.             If BallY(ball) < BallRadius(ball) Then
  249.                 BallY(ball) = 2 * BallRadius(ball) - BallY(ball)
  250.                 BallDy(ball) = -BallDy(ball)
  251.             ElseIf BallY(ball) > ymax - BallRadius(ball) Then
  252.                 BallY(ball) = 2 * (ymax - BallRadius(ball)) - BallY(ball)
  253.                 BallDy(ball) = -BallDy(ball)
  254.             End If
  255.         Next ball
  256.         If Not Playing Then Exit Do
  257.     Loop
  258. End Sub
  259. Private Sub Form_Load()
  260.     Randomize
  261.     picCourt.FillStyle = vbSolid
  262.     picCourt.ScaleMode = vbPixels
  263.     With picHidden(0)
  264.         .AutoRedraw = True
  265.         .Visible = False
  266.         .ScaleMode = vbPixels
  267.         .BorderStyle = vbBSNone
  268.     End With
  269. End Sub
  270. ' Make the ball court nice and big.
  271. Private Sub Form_Resize()
  272. Const GAP = 3
  273.     txtFramesPerSecond.Top = ScaleHeight - GAP - txtFramesPerSecond.Height
  274.     Label1(0).Top = txtFramesPerSecond.Top
  275.     txtNumBalls.Top = txtFramesPerSecond.Top - GAP - txtNumBalls.Height
  276.     Label1(1).Top = txtNumBalls.Top
  277.     cmdStart.Top = (txtNumBalls.Top + txtFramesPerSecond.Top + txtFramesPerSecond.Height - cmdStart.Height) / 2
  278.     picCourt.Move 0, 0, ScaleWidth, txtNumBalls.Top - GAP
  279.     xmax = picCourt.ScaleWidth - 1
  280.     ymax = picCourt.ScaleHeight - 1
  281.     picCourt.Picture = picCourt.Image
  282. End Sub
  283.